perm filename SLURZ.F4[NEW,LCS]7 blob
sn#552722 filedate 1980-12-17 generic text, type T, neo UTF8
C***** SLURZ -- NREST (FOR BEAMS)
SUBROUTINE SLURZ
INTEGER UPDN
COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
1 /XRN/RN(1) /PTR/KWDS(1)
1 /RINP/R(10,85),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS /ALF/INP(72),ML
1 /LIMIT/LIMIT,ITEM,LL,IS,IX
1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
1 /SCX/JALPHA(7),ISTAR,JAL(22),JX,U,JZ,IRHY,JD,KA,KB,IZ
1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
1 ,JXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
251 INVT=-1
LS=IS
C SAVE PTR TO RN ARRAY FOR SLUR FEATURE AT 614 (AND TREM. FEATURE)
JNTC=NTC-1
C JNTC=NUM OF NTS NOW
125 IF(REND.NE.0)GO TO 25
REND=3
25 CALL XREAD
C ******* 1ST MAIN LOOP *********
JMP=1
505 L=0
K=0
POS=-10.
RN(8+IS)=0
RN(9+IS)=0
IT=0
UPDN=0
C UPDN=2=STEMS DOWN, (SLUR DIP UP) =1, OPPOSITE.
104 JA=J+1
B=VX(JA)
C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
IF(B.LT.100)GO TO 512
UPDN=2
B=B-100
IF(B.GT.100)B=100-B
C TYPE -NUM OR 200+NUM FOR DIP DOWN.
VX(JA)=B
512 IF(B)UPDN=1
RN(9+IS)=0
BRK=AMOD(VX(J),1.)*10.
IF(BRK.EQ.0)GO TO 503
C ADDS NUM TO BRACK. OR BEAM. ADD DESIRED .NUM TO 1ST NUM.(1.3=3)
RN(9+IS)=BRK+.0001
GO TO 5030
503 IF(N.GT.0)GO TO 5031
IT=-1
CALL SLEND
C -1= SLUR INTO 1ST NOTE.
C SETS POS OF LFT SIDE (-10+9, THEN +2)
GO TO 5060
5031 IF(N.LE.JNTC)GO TO 5030
C JNTC=NUM OF REAL NTS+1
CALL SLEND
C SLEND CHECKS ON END POINTS OF THIS STAFF
GO TO 504
C -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
5032 IF(N.LE.JNTC)GO TO 5030
N=JNTC
C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
VX(J)=N
C VX(J)=N IS NEEDED AT LABEL 130
5030 L=L+1
502 K=K+1
IF(R(1,K).NE.1.)GO TO 502
C IS IT A NOTE?
P=R(3,K)
IF(P.EQ.POS)GO TO 502
C SKIPS DBLSTPS
POS=P
506 IF(L.LT.N)GO TO 5030
C NOW SLUR STARTS
5060 IF(JMP)GO TO 504
C JMP=-1 MEANS END NOTE OF GROUP
J=J+1
NN=VX(J)
C IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
IF(NN.EQ.0)NN=N+1
IF(NN.EQ.0)NN=1
IF(NN)GO TO 777
IF(NN.LE.N)NN=N+1
C FOR USE WITH AUTO-BEAMS OR DIP UP. 2-NOTE SLUR OR BEAM UP.
777 CONTINUE
5061 MK=N
N=IABS(NN)
M=K
JA=3
JB=4
KN=K
RB=0
IBR=6
C 6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
CC*** NOT NEEDED NOW WITH UPDN FEATURE. IF(STEM.GE.0)NN=-NN
IF(IT)GO TO 550
C IT=-1=SLUR INTO 1ST NOTE.
A=XNOTE(K)
C XNOTE IS AMOD(R(4,K),100.)
C SAVES LEVEL OF 1ST NOTE.
504 RB=2
IF(NN)RB=-RB
C DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
550 RN(JA+IS)=POS
B=XNOTE(K)
SLUR=0
C A FLAG FOR LATER USE.
JA=K
IF(JA.NE.0)GO TO 451
1451 JA=JA+1
IF(R(1,JA).NE.1)GO TO 1451
451 MB=R(5,JA)/10.
IF(MB.NE.0)GO TO 450
MB=1
X=R(4,JA)
IF(X.GT.80)X=X-100
IF(X.GT.6)MB=2
450 IF(UPDN.EQ.0)GO TO 515
IF(MB.EQ.UPDN)GO TO 515
X=6
IF(NN)X=-X
RB=RB+X
JA=3
IF(JMP)JA=6
IF(NN)GO TO 204
IF(UPDN.EQ.2)GO TO 516
204 IF(UPDN.EQ.1)GO TO 516
C ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
RB=-RB
NN=-NN
516 IF(K.GT.1)GO TO 16
IF(IT)GO TO 513
16 IF(K.NE.JNTC)GO TO 116
IF(N.GT.JNTC)GO TO 513
C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
116 SLUR=0.5
IF(UPDN.EQ.1)SLUR=-SLUR
SLUR=SLUR*RSTJ2
RN(JA+IS)=RN(JA+IS)+SLUR
C THIS NOT DONE IF SLUR TO FIRST NOTE
GO TO 513
517 IF(MB.EQ.1)GO TO 513
IF(RB)RB=-RB
GO TO 518
515 UPDN=MB
C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
IF(NN)GO TO 517
IF(MB.NE.1)GO TO 513
RB=-RB
518 NN=-NN
513 RN(JB+IS)=B+RB
C MK=# OF 1ST NOTE, N=END NOTE NOW
JMP=-JMP
IF(JMP.GT.0)GO TO 1503
C GO FIND RT. SIDE OF SLUR
JA=6
JB=5
IF(N.LE.MK)N=MK+1
C PICKS UP TYPO ERRORS
JK=0
IF(R(7,K).GE.10)JK=-1
C CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
GO TO 503
1503 RN(2+IS)=STAFF
5503 RN(8+IS)=-1
RN(1+IS)=5
IF(IT)RN(4+IS)=RN(5+IS)
NN=-NN
C IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
IF(N.EQ.99)GO TO 200
C TYPE /n 99/ FOR SLUR BEYOND NOTE HEAD (TO DIFF. PITCH ON NEXT LINE)
C /n x/ IS TIE TO SAME NOTE ON NEXT LINE. (X IS ANY NUMBER > LAST NOTE NUM.)
IF(MK.EQ.-99)GO TO 200
C TYPE /-99 n/ FOR SLUR FROM DIFF. NOTE ON PREVIOUS LINE.
C /0 n/ OR /-1 n/ IS TIE FROM SAME NOTE, PREV. LINE
C=0
C C WILL BE FLAG IN SECTION ON TIES BETWEEN CHORDS (AT 114)
AA=XNOTE(K)
IF(MK.EQ.JNTC)GO TO 61
C JNTC (NOTE COUNT) THE LAST NOTE(OR CHORD) OF INPUT
IF(N.EQ.1)GO TO 61
IF(IT)GO TO 2114
IF(N-MK.GT.1)GO TO 2114
C M=1ST NOTE OF SLUR, K=LAST
B=R(5,K)
IF(AMOD(B,10.0).GT.0)GO TO 65
C JUMP IF LAST NOTE HAS ACCI.
C JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
C JUMP IF SLUR IS VERY SHORT
IF(AA.EQ.A)GO TO 61
C NEXT FOR NOTES AT DIFFERENT LEVELS
IF(B.LT.20)GO TO 161
C ARE STEMS THE SAME DIRECTION. JUMP OUT IF SO.
IF(R(5,M).GE.20)GO TO 2114
GO TO 61
161 IF(R(5,M).LT.20)GO TO 2114
61 IF(IT)A=AA
C IT=-1=SLUR INTO 1ST NOTE.
C=6
IF(JK)C=8
JB=6+IS
C=RN(JB)-RN(3+IS)-C*RSTJ2
CATCHES VERY SHORT SLURS - OR 1ST NOTE HAS 2 OR MORE TAILS (PUTS SLUR ABOVE)
IF(AMOD(R(7,M),10.0).GE.2.)C=-1
B=-.7
IF(C.OR.A.NE.AA)B=-1.8
IF(NN)B=-B
C TO RAISE OR LOWER IT .7
C12/80 RN(4+IS)=A+B
C12/80 RN(5+IS)=AA+B
RA=A+B
RB=AA+B
C JB = 6+IS
CALL SLRLEV(RA,RB,NN,C,RN(JB))
C RA=LEFT LEVEL OF SLUR, RB=RIGHT LEVEL, NN=NEG=SLUR 'DIP' IS UP
RN(4+IS)=RA
RN(5+IS)=RB
C ABOVE LINES FOR SLURS WHEN STEMS GO OPPOSITE DIRECTIONS.
B=-2
IF(JK)B=-3
C JK=-1 WHEN NOTE IS DOTTED.
C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
IF(C)B=-1
RN(8+IS)=B
IF(SLUR.EQ.0)GO TO 65
RN(3+IS)=RN(3+IS)-SLUR
RN(JB)=RN(JB)-SLUR
C PUSH SLUR BACK TO WHERE IT WAS
GO TO 65
C NEXT TO SHIFT SLUR IN RE. TO MARKS. STAC., TEN., ACC.
C ***********KN = 1ST NOTE, K=LAST NOTE.********
2114 JA=KN
JB=4
2503 RB=R(2,JA)
IF(RB.EQ.0)GO TO 3503
IF(BRK.NE.0)GO TO 6503
C IS IT A BRACKET INSTEAD OF A SLUR?
IF(RB.EQ.4.OR.RB.EQ.5)GO TO 4503
IF(RB.NE.7.AND.RB.NE.9)GO TO 3503
6503 RB=1.5
IF(R(5,JA).LT.20)RB=-RB
RN(IS+JB)=RN(IS+JB)+RB
GO TO 3503
4503 L=R(9,JA)
C THE POINTER TO P11 WAS SAVED HERE BY 'NEWR'
RN(L)=RN(L)+.2
3503 IF(JA.EQ.K)GO TO 200
CC3503 IF(JA.EQ.K)GO TO 60
JA=K
JB=JB+1
GO TO 2503
CC60 IF(STEM.GE.0)GO TO 200
C JUMP IF SLURS**************
62 IF(NN)GO TO 64
IF(A.EQ.DMAX)GO TO 65
AA=B-DMAX
GO TO 63
65 AA=0
GO TO 63
64 IF(A.EQ.UMAX)GO TO 65
AA=UMAX-B
63 RA=RN(6+IS)
RB=RN(3+IS)
RN(7+IS)=0
C ABOVE FOR FUNCTION RCURVE. RN(7+IS)=X LATER ON.
X=RCURVE(RN(3+IS))
CC X=0.9+(RA-RB)/25.+ABS(RN(4+IS)-RN(5+IS))/10.
C CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
IF(AA.GT.0)X=X+AA*.5
IF(BRK.EQ.0)GO TO 66
RN(8+IS)=1
RN(3+IS)=RB-.6
CC********** RB=R(3,K+1)
C K=END NOTE OF GROUP
CC********** IF(K.EQ.IZ)RB=200.
C IZ IS LAST ITEM IN R(N,M)
CXXXX IF(K.EQ.IRHY)RB=200.
C ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
RN(6+IS)=RA+4*RSTJ2
C PUT RIGHT END OF BRACKET A LITTLE BEYOND LAST NOTE.
CC********** RN(6+IS)=RA+(RB-RA)/2.
IBR=7
C CHECK THESE NUMBERS↑↑↑↑
B=RN(4+IS)
BB=RN(5+IS)
RA=1
IF(A.LT.-1)RA=2.5
C CHANGES HEIGHT. MAKES BRACK. IF N>100.
IF(NN.GT.0)RA=-RA
RN(4+IS)=B+RA
RN(5+IS)=BB+RA
X=2
66 IF(NN.GT.0)X=-X
510 RN(7+IS)=X
2514 L=IS
CALL UPDATE(IBR)
IF(C.EQ.0)GO TO 514
C JUMP OUT IF INTERVENING NOTE. C≠0 = TIE BETWEEN NOTES
IF(RN(L+4).NE.RN(L+5))GO TO 514
C IS IT LEVEL?
IF(BRK.NE.0)GO TO 514
C JUMP OUT IF A BRACKET
B=-RN(IS-2)
C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
D=.7
IF(RN(L+8).EQ.-1)D=D+1.3
CZ RA=.7
CZ IF(RN(L+8).EQ.-1)RA=RA+1.3
C IS TIE NOT BETWEEN NOTES?
IF(NN.GT.0)D=-D
CZ IF(NN.GT.0)RA=-RA
C DIP DIRECTION. NN+ =DOWN, NN- =UP. REVERSED AFTER 1ST ONE.
C=-2.
IF(RN(L+8).EQ.-3.)C=-3.
C PUT TIE BETWEEN NOTES ALWAYS.
JA=M
JB=K
IF(MK)JA=JB
C FOR TIES TO 1ST OF LINE
IF(N.GT.JNTC)JB=JA
C FOR END OF LINE CHORDS JNTC=TOTAL OF NOTES (NOTE COUNT)
RC=R(3,JA)
114 JA=JA+1
JB=JB+1
IF(RC.NE.R(3,JA))GO TO 514
C JUMP IF RIGHT-HAND NOTE NOT IN SAME POS.
IF(R(1,JA).NE.1)GO TO 514
C CATCHES THINGS BETWEEN NOTES
IF(R(4,JA).NE.R(4,JB))GO TO 514
C LOOKS FOR PARALLEL CHORDS NOTES
A=XNOTE(JA)
BB=D
CZ BB=RA
IF(AMOD(A,2.0).EQ.0)BB=BB/2.
C MOVE SLUR 1/2 IF IT WOULD LAND ON A SPACE (EVEN NUMS).
A=A-BB
CF RN(IS)=6.
CF RN(IS+1)=5.
CF RN(IS+2)=RN(IS-7)
CF RN(IS+3)=RN(IS-6)
CF RN(IS+6)=RN(IS-3)
CF RN(IS+7)=B
CF RN(IS+8)=C
CF RN(IS+4)=A
CF RN(IS+5)=A
CALL RNX(6.,5.,RN(IS-7),RN(IS-6),A,A,RN(IS-3),B,C)
CALL UPDATE(IBR)
GO TO 114
514 J=J+1
A=VX(J)
N=A
C SO ITEMS NEED NOT BE IN RIGHT ORDER.
IF(MOD(N,100).GT.IRHY)A=0
IF(A.NE.0)GO TO 505
CC***USE NO NUMBS IN COMMENTS IN MODE 3-5****** IF(VX(J+2).EQ.0)GO TO 614
IF(J.LT.50)GO TO 514
C SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
614 IF(INP(72).NE.ISTAR)GO TO 552
C NEXT FOR TWO SLURS ON SAME POS. LOOKS AT LEFT SIDE FIRST.
NS=LS
MB=LS
C INITIALIZE MB IN CASE IT SKIPS PAST 814.
C NEXT ARE PARAMS 4, 3, 6 OF SLUR. 2ND TIME AROUND USE 5, 6, 3.
N=4
NA=3
NB=6
1314 IF(RN(LS+8).LT.-1)GO TO 1014
C SKIP OUT IF SLUR IS IN BETWEEN NOTES (P8=-2 OR -3)
JS=LS
X=1.8
IF(RN(LS+7))X=-X
A=RN(LS+NA)
B=RN(LS+NB)
C A AND B ARE THE TWO HORIZ. POSITIONS. RA IS HEIGHT.
RA=RN(LS+N)
814 MB=RN(JS)+JS+3
C MB IS THE NEXT SLUR
IF(MB.LT.IS)GO TO 1514
LS=RN(LS)+LS+3
C MOVE AHEAD ONE SLUR
IF(LS.GE.IS)GO TO 1214
GO TO 1314
1514 IF(RN(MB+8).LT.-1)GO TO 1014
IF(A.NE.RN(MB+NA))GO TO 1014
D=RN(MB+NB)
C MAYBE PUT IN SOMETHING HERE TO CATCH SLURS WITH OPPOSITE DIPS.
JB=MB
IF(N.EQ.5)GO TO 1414
IF(B.GT.D)JB=LS
GO TO 1114
1414 IF(D.GT.B)JB=LS
1114 BB=RN(N+JB)
IF(ABS(BB-RA).LT.0.5)RN(N+JB)=BB+X
C SHIFT HEIGHT OF SLUR ONLY IF HEIGHT IS CURRENTLY THE SAME.
1014 JS=MB
GO TO 814
1214 IF(N.EQ.5)GO TO 714
C START AGAIN, LOOK AT RIGHT END OF SLURS NOW
N=N+1
NA=6
NB=3
LS=NS
GO TO 1314
714 IF(INVT)RETURN
INVT=IS
CALL NEWR
IS=INVT
RETURN
552 CALL BMREAD
C TO READ MORE THAN 2 LINES.
GO TO 25
200 M=KN
JMAX=0
IF(N-MK.EQ.1)JMAX=-1
207 L=M+1
IF(R(1,L).NE.1)GO TO 307
IF(R(5,L).GE.10)GO TO 307
M=M+1
GO TO 207
C FOR HEIGHTS OF DBL STPS, ETC.
307 CONTINUE
607 A=XNOTE(M)
C A=NOTE 1.
UMAX=A
DMAX=A
C UP MAX. NOTE #, DOWN MAX. NOTE #.
407 M=K+1
IF(R(1,M).NE.1)GO TO 103
IF(R(5,M).GE.10)GO TO 103
C FINDS DBL+ STP ON LAST OF BEAM
IF(R(6,M))GO TO 103
C JUMP OUT IF A WHITE NOTE
K=M
GO TO 407
CX103 IF(STEM.EQ.0)GO TO 603
CX MMS=R(5,KN)/10.
CX DO 703 M=KN+1,K
CX703 IF(MMS.NE.IFIX(R(5,M)/10.))GO TO 4
C SKIP NEXT IF STEMS ARE SPECIFIED IN DIFF. DIRECTIONS. (GRACE NTS??)
CX603 DO 3 M=KN,K
103 DO 3 M=KN,K
IF(R(1,M).NE.1)GO TO 3
CXCXCX IF(STEM.NE.0.AND.R(10,M).NE.0)GO TO 3
C SKIP NOTES ON OTHER STAFF
IF(M.EQ.K)GO TO 107
IF(R(1,M+1).NE.1)GO TO 107
C IT ONLY CARES ABOUT NOTES!
IF(R(5,M+1).LT.10)GO TO 3
C IGNORE LOWER (OR UPPER) NOTES OF CHORDS (NO STEM)-IN RE. UP-DOWN FEATURE.
CC107 IF(MB)GO TO 7
C SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
107 IF(ABS(R(4,M)).GE.100)GO TO 3
C SKIPS NON-NOTES
7 B=XNOTE(M)
55 IF(B.LT.UMAX)GO TO 13
UMAX=B
IF(JMAX)GO TO 3
IF(M.EQ.KN)GO TO 3
IF(M.EQ.K)GO TO 3
UMAX=UMAX+1
GO TO 3
13 IF(B.GT.DMAX)GO TO 3
DMAX=B
IF(JMAX)GO TO 3
IF(M.EQ.KN)GO TO 3
IF(M.EQ.K)GO TO 3
DMAX=DMAX-1
3 CONTINUE
C LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
4 GO TO 62
END
FUNCTION NREST(K)
COUNTS REST FROM START OF LINE UP TO ITEM K-1 (K IS A NOTE)
COMMON /SCM/V(1)
NREST=0
DO 1 J=1,K-1
1 IF(V(J))NREST=NREST+1
END